perm filename MPRNT.F4[1,MUS] blob sn#078086 filedate 1973-12-16 generic text, type T, neo UTF8
00100	C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200	C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00300	C  LOAD WITH PPSRT, PLTCMD, NOTWRT, ITMSBX, TREST, CLFZ, LOOK
00400	
00500		IMPLICIT INTEGER(A-Q,S-Z)
00600		REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00700		COMMON /DL/IXRX,SAVER,NAME
00800		DIMENSION V(78),LIST(200)
00900		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
01000		COMMON/ALF/INP(3),ML/XRN/RN(4000)/STF/RSTFAC(8),RSTJC
01100		COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/POSI/STFF(8),JJB,POS
01300		COMMON/DPY/GO,RXGP,TOP,BOT
01400		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500		1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JF,JQ(4)),(RJG,RJQ(5))
01600	     1,(RJD,RJQ(2)),(RJC,RJQ(1)),(I1,INP(1)),(V,RN(3000))
01700		1,(LIST,RN(3100))
01800		DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
01900		1 ,IP/'P'/
02000	
02100		TOP2=-999
02200		RXGP=0
02300		I1=0
02400	C  RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
02500	2	PLOTIT=0
02600		RSZ=.845
02700		TOP=-999
02800		BOT=999
02900		PLT=0
03000		PWDS(1)=1.
03100		EDX=-1
03200		DO 1402 K=1,8
03300	1402	RSTFAC(K)=1.
03400		M=1
03500		ITEM=0
03600		IXRX=0
03700		I=1
03800	58	GO=-1
03900		GO TO 5504
04000	
04100	
04200	11	CALL NOTWRT
04300	57	IF(PLT)GO TO 6120
04400		ITEM=ITEM+1
04500		IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
04600		IF(PLOTIT.EQ.-2)GO TO 2311
04700		PWDS(ITEM+1)=I
04800		PLT=0
04900		GO=-1
05000	
05100	5504	IF(I1.EQ.IP)GO TO 2311
05200	59	TYPE 56
05300		ACCEPT 89,INP
05400	311	JA=0
05500		IF(I1.NE.IP)GO TO 85
05600	2311	CALL PLTCMD
05700		IF(PLOTIT.EQ.0)GO TO 3005
05800		I1=IP
05900		PLOTIT=-1
06000	C  'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
06100	89	FORMAT(72A1)
06200	
06300	6531	M=1
06400		EDX=-1
06500		DO 5532 K=1,9
06600	5532	JQ(K)=RJQ(K)
06700	590	IF(PLOTIT.EQ.-1)GO TO 121
06800		I1=0
06900	243	RJB=1.
07000	C TO RUN THROUGH DATA.
07100	241	RSZ=.845*RJB
07200		RJB=0
07300		RJC=0
07400		RJD=0
07500		TOP=-999
07600		BOT=999
07700	C  GOES TO PLOTTER
07800	85	M=1
07900		I=PWDS(ITEM+1)
08000		ITEM=0
08100	8852	PLT=1
08200		EDX=0
08300		GO=0
08400		GO TO 6120
08500	
08510	60	IF(JA.NE.88)GO TO 601
08520		RSTFAC(JC+4)=RJB
08525	C  FOR STAFF SIZE FACTOR WITHOUT STAFF.
08530		GO TO 57
08600	601	RSTJC=RSTFAC(JC+4)
08700	5541	POS=STFF(JC+4)
08800		JB=RHORZ(RJB)
08900	C  LINE IS DIVIDED INTO 200 POINTS.
09000		CENTR=POS
09100	551	IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
09200		IF(JA.EQ.7)GO TO 81
09300		IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
09400		IF(JA.EQ.18)GO TO 80
09500		CALL ALPHA
09600		GO TO 57
09700	
09800	81	CALL KSIG
09900		GO TO 57
10000	
10100	80	CALL METER
10200		GO TO 57
10300	
10400	25	CALL ITMSUB
10500	C   BAR LINES, BEAMS, STAFF LINES ****
10600		GO TO 57
10700	
10800	3005	REWIND 21
10900	C  GUARDS AGAINST LOSSAGE!
11000		PLOTIT=-2
11100		CALL IFILE(21,NAME)
11200	C  JUMP TO READ BIG FILES
11300	2200	J=ITEM+1
11400	2202	READ(21),X,Y,
11500		1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
11600		1 LCNT,(LIST(K),K=1,LCNT)
11700		READ(21),RSTFAC,STFF
11800		ITEM=ITEM+X
11900		I=Y
12000		GO TO 6531
12100	121	IF(PLOTIT.EQ.0)GO TO 5504
12200	5121	CALL PLTSRT
12300	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
12400		PLT=-1-JH
12500	C  (JH) P8=1 OR 2 FOR 2-PASS PLOTS
12600		M=I
12700		I=I+M-1
12800		IF(RJB.EQ.0)RJB=1.
12900		DIS=RJB*1.24
13000		IF(RJC.EQ.0)RJC=RJB
13100		RHT=RJC*1.2
13200	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
13300		BOT=-BOT*RHT
13400		IF(TOP2.EQ.-999)GO TO 8121
13500		BOT=BOT+TOP2
13600		GO TO 9121
13700	8121	CALL PLOTS(K)
13800		RXGP=995.-BOT
13900	9121	NOMOVE=RJF+RJG*148.*RJC
14000	C  RJF=1 FOR NO MOVE AT END.  RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
14100		IXGP=JD
14200	C (JD) P4=1 FOR XGP OUTPUT
14300		IF(JE.NE.0)GO TO 1122
14400		IF(RJD.EQ.0)GO TO 6121
14500		IF(TOP2.NE.-999)RXGP=RXGP-BOT
14600	C  MOVES 0 POINT OVER EACH TIME.
14700		GO TO 1122
14800	6121	CALL PLOT(0,BOT,-3)
14900	C  MOVES PLOTTER UP IF P5=0.
15000	1122	IXRX=IXGP
15100	
15200	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
15300	6120	IF(M.GE.I)GO TO 7120
15400		CNT=RN(M)
15500		DO 6220 K=CNT+1,10
15600		JQ(K)=0
15700	6220	RJQ(K)=0
15800		JA=RN(M+1)
15900		M=M+2
16000		RJB=RN(M)
16100		DO 9120 K=1,CNT
16200		RJQ(K)=RN(M+K)
16300	9120	JQ(K)=RJQ(K)
16400		M=CNT+M+1
16500		IF(EDX.LE.0)GO TO 60
16600		GO TO 5504
16700	
16800	7120	M=1
16900		IF(EDX)GO TO 71201
17000		IF(PLT.EQ.1)EDX=-1
17100		PLT=0
17200	C  RETURNS FOR 'SL'=SAVE LAST
17300		GO TO 5504
17400	71201	X=50*RHT
17500		TOP=TOP*RHT+X
17600		IF(NOMOVE.NE.0)TOP=0
17700		IF(NOMOVE.GT.1)TOP=NOMOVE
17800		IF(IXGP.EQ.0)CALL PLOT(0,TOP,3)
17900		TOP2=TOP
18000		GO TO 2
18100	C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
18200	C  MOVES PLOTTER UP
18300	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
18400	
18500	56	FORMAT(' PXG OR PXC'/)
18600		END